home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / c / genmo112.lha / GTB-Modula / GenModula / GenerateScreen.mod < prev    next >
Encoding:
Modula Implementation  |  1993-09-28  |  20.7 KB  |  847 lines
  1. IMPLEMENTATION MODULE GenerateScreen;
  2.  
  3. (*
  4.  * -------------------------------------------------------------------------
  5.  *
  6.  *    :Program.    GenModula
  7.  *    :Contents.    A Modula 2 Sourcecode generator for GadToolsBox
  8.  *
  9.  *    :Author.    Reiner B. Nix
  10.  *    :Address.    Geranienhof 2, 50769 Köln Seeberg
  11.  *    :Address.    rbnix@pool.informatik.rwth-aachen.de
  12.  *    :Copyright.    Reiner B. Nix
  13.  *    :Language.    Modula-2
  14.  *    :Translator.    M2Amiga A-L V4.2d
  15.  *    :Imports.    GadToolsBox, NoFrag  by Jaan van den Baard
  16.  *    :Imports.    InOut, NewArgSupport by Reiner Nix
  17.  *    :History.    this programm is a direct descendend from
  18.  *    :History.     OG (Oberon Generator) 37.11 by Thomas Igracki, Kai Bolay
  19.  *    :History.    GenModula 1.10 (23.Aug.93)    ;M2Amiga 4.0d
  20.  *    :History.    GenModula 1.12 (28.Sep.93)    ;M2Amiga 4.2d
  21.  *
  22.  * -------------------------------------------------------------------------
  23.  *)
  24.  
  25. FROM    SYSTEM            IMPORT    LONGSET,
  26.                     CAST;
  27. FROM    String            IMPORT    Length;
  28. FROM    GraphicsD        IMPORT    palMonitorID, ntscMonitorID,
  29.                     superlaceKey, hireslaceKey, loreslaceKey,
  30.                     superKey, hiresKey,
  31.                     FontStyles, FontStyleSet,
  32.                     FontFlags, FontFlagSet;
  33. FROM    IntuitionD        IMPORT    SaTags;
  34. FROM    GadToolsD        IMPORT    GtTags;
  35. FROM    UtilityD        IMPORT    Tag,
  36.                     tagEnd,
  37.                     TagItem, TagItemPtr;
  38. FROM    FileOut            IMPORT    Write, WriteString, WriteLn,
  39.                     WriteCard, WriteInt, WriteHex;
  40. FROM    GadToolsBox        IMPORT    maxColorSpec, maxDriPens, maxFontName,
  41.                     GadgetFlags, GadgetFlagSet,
  42.                     GuiFlags, GuiFlagSet,
  43.                     GenCFlags,
  44.                     GTConfigFlags;
  45. FROM    GeneratorIO        IMPORT    dfile, mfile, args,
  46.                     Gui, MainConfig, CConfig, Projects,
  47.                     WriteText, WriteFill, SeekBack, GetAttrName;
  48.  
  49.  
  50.  
  51. PROCEDURE CheckFont        () :BOOLEAN;
  52.  
  53. BEGIN
  54. IF FontAdapt IN MainConfig.configFlags0 THEN
  55.   RETURN FALSE
  56.  
  57. ELSE
  58.   RETURN (gcGenOpenFont IN CConfig) AND
  59.          (romFont IN Gui.font.flags)
  60.   END
  61. END CheckFont;
  62.  
  63.  
  64.  
  65. PROCEDURE WriteScreenDefs;
  66.  
  67. VAR    colorNumber, penNumber    :CARDINAL;
  68.     attrName        :ARRAY [0..maxFontName] OF CHAR;
  69.  
  70. BEGIN
  71. WriteString (mfile, "\t");
  72. WriteString (mfile, "Screen");
  73. WriteFill   (mfile, "", 6);
  74. WriteString (mfile, ":ScreenPtr;");
  75. WriteLn (mfile);
  76.  
  77. WriteString (mfile, "\t");
  78. WriteString (mfile, "VisualInfo");
  79. WriteFill   (mfile, "", 10);
  80. WriteString (mfile, ":ADDRESS;");
  81. WriteLn (mfile);
  82.  
  83. IF CheckFont () THEN
  84.   WriteString (mfile, "\t");
  85.   WriteString (mfile, "Font");
  86.   WriteFill   (mfile, "", 4);
  87.   WriteString (mfile, ":TextFontPtr;");
  88.   WriteLn (mfile)
  89.   END;
  90.  
  91. IF FontAdapt IN MainConfig.configFlags0 THEN
  92.   WriteString (mfile,"\t");
  93.   WriteString (mfile, "Font");
  94.   WriteFill   (mfile, "", 4);
  95.   WriteString (mfile, ":TextAttrPtr;");
  96.   WriteLn (mfile);
  97.  
  98.   WriteString (mfile,"\t");
  99.   WriteString (mfile, "Attr");
  100.   WriteFill   (mfile, "", 4);
  101.   WriteString (mfile, ":TextAttr;");
  102.   WriteLn (mfile);
  103.  
  104.   WriteString (mfile,"\t");
  105.   WriteString (mfile, "FontX, FontY");
  106.   WriteFill   (mfile, "", 12);
  107.   WriteString (mfile, ":INTEGER;");
  108.   WriteLn (mfile);
  109.  
  110.   WriteString (mfile,"\t");
  111.   WriteString (mfile, "OffX, OffY");
  112.   WriteFill   (mfile, "", 10);
  113.   WriteString (mfile, ":INTEGER;");
  114.   WriteLn (mfile)
  115.  
  116. ELSE
  117.   GetAttrName (attrName);
  118.  
  119.   WriteString (mfile, "\t");
  120.   WriteString (mfile, attrName);
  121.   WriteFill   (mfile, attrName, 0);
  122.   WriteString (mfile, ":TextAttr;");
  123.   WriteLn (mfile)
  124.   END;
  125.  
  126. IF Custom IN Gui.flags0 THEN
  127.   IF Gui.colors[0].colorIndex # -1 THEN
  128.     colorNumber := 0;
  129.     WHILE (colorNumber < maxColorSpec) AND
  130.           (Gui.colors[colorNumber].colorIndex # -1) DO
  131.       INC (colorNumber)
  132.       END;
  133.  
  134.     WriteString (mfile, "\t");
  135.     WriteString (mfile, "ScreenColors");
  136.     WriteFill   (mfile, "", 12);
  137.     WriteString (mfile, ":ARRAY [0..");
  138.     WriteCard   (mfile, colorNumber, 2);
  139.     WriteString (mfile, "] OF ColorSpec;");
  140.     WriteLn (mfile)
  141.     END;
  142.  
  143.  
  144.   penNumber := 0;
  145.   WHILE (penNumber < maxDriPens) AND
  146.         (Gui.driPens[penNumber] # MAX (CARDINAL)) DO
  147.     INC (penNumber)
  148.     END;
  149.  
  150.   WriteString (mfile, "\t");
  151.   WriteString (mfile, "DriPens");
  152.   WriteFill   (mfile, "", 7);
  153.   WriteString (mfile, ":ARRAY [0..");
  154.   WriteCard   (mfile, penNumber, 2);
  155.   WriteString (mfile, "] OF CARDINAL;");
  156.   WriteLn (mfile)
  157.   END
  158. END WriteScreenDefs;
  159.  
  160.  
  161.  
  162. PROCEDURE WriteScreenProcs    (    GetFilePresent    :BOOLEAN);
  163.  
  164. VAR    attrName        :ARRAY [0..maxFontName] OF CHAR;
  165.  
  166.  
  167.   PROCEDURE WriteTextAttrInit    (    attrName        :ARRAY OF CHAR);
  168.  
  169.   VAR    fontStyleNames        :ARRAY FontStyles,[0..20] OF CHAR;
  170.       fontFlagNames        :ARRAY FontFlags ,[0..20] OF CHAR;
  171.       s            :FontStyles;
  172.       f            :FontFlags;
  173.  
  174.   BEGIN
  175.   IF NOT (FontAdapt IN MainConfig.configFlags0) THEN
  176.     fontStyleNames[underlined] := "underlined,";
  177.     fontStyleNames[bold      ] := "bold,";
  178.     fontStyleNames[italic    ] := "italic,";
  179.     fontStyleNames[extended  ] := "extended,";
  180.     fontStyleNames[fs4       ] := "fs4,";
  181.     fontStyleNames[fs5       ] := "fs5,";
  182.     fontStyleNames[colorFont ] := "colorFont,";
  183.     fontStyleNames[tagged    ] := "tagged,";
  184.  
  185.     fontFlagNames[romFont     ] := "romFont,";
  186.     fontFlagNames[diskFont    ] := "diskFont,";
  187.     fontFlagNames[revPath     ] := "revPath,";
  188.     fontFlagNames[tallDot     ] := "tallDot,";
  189.     fontFlagNames[wideDot     ] := "wideDot,";
  190.     fontFlagNames[proportional] := "proportional,";
  191.     fontFlagNames[designed    ] := "designed,";
  192.     fontFlagNames[removed     ] := "removed,";
  193.  
  194.  
  195.     WriteLn (mfile);
  196.     WriteString (mfile, "PROCEDURE Init");
  197.     WriteString (mfile, args.BaseName);
  198.     WriteString (mfile, "TextAttr;");
  199.     WriteLn (mfile);
  200.     WriteLn (mfile);
  201.  
  202.     WriteString (mfile, "BEGIN");
  203.     WriteLn (mfile);
  204.  
  205.     WriteString (mfile, "WITH ");
  206.     WriteString (mfile, attrName);
  207.     WriteString (mfile, " DO");
  208.     WriteLn (mfile);
  209.  
  210.     WriteString (mfile, "  name  := ADR ('");
  211.     WriteString (mfile, Gui.fontName);
  212.     WriteString (mfile, "');");
  213.     WriteLn (mfile);
  214.  
  215.     WriteString (mfile, "  ySize := ");
  216.     WriteCard   (mfile, Gui.font.ySize, 1);
  217.     Write       (mfile, ";");
  218.     WriteLn (mfile);
  219.  
  220.     IF Gui.font.style = FontStyleSet {} THEN
  221.       WriteString (mfile, "  style := FontStyleSet {};");
  222.       WriteLn (mfile)
  223.     ELSE
  224.       WriteString (mfile, "  style := FontStyleSet {");
  225.       FOR s := MIN (FontStyles) TO MAX (FontStyles) DO
  226.         IF s IN Gui.font.style THEN
  227.           WriteString (mfile, fontStyleNames[s])
  228.           END
  229.         END;
  230.  
  231.       SeekBack (mfile, 1);
  232.       WriteString (mfile, "};");
  233.       WriteLn (mfile)
  234.       END;
  235.  
  236.     IF Gui.font.flags = FontFlagSet {} THEN
  237.       WriteString (mfile, "  flags := FontFlagSet {}");
  238.       WriteLn (mfile)
  239.     ELSE
  240.       WriteString (mfile, "  flags := FontFlagSet {");
  241.       FOR f := MIN (FontFlags) TO MAX (FontFlags) DO
  242.         IF f IN Gui.font.flags THEN
  243.           WriteString (mfile, fontFlagNames[f])
  244.           END
  245.         END;
  246.  
  247.       SeekBack (mfile, 1);
  248.       WriteString (mfile, "}");
  249.       WriteLn (mfile)
  250.       END;
  251.  
  252.     WriteString (mfile, "  END");
  253.     WriteLn (mfile);
  254.  
  255.     WriteString (mfile, "END Init");
  256.     WriteString (mfile, args.BaseName);
  257.     WriteString (mfile, "TextAttr;");
  258.     WriteLn (mfile);
  259.     WriteLn (mfile)
  260.     END
  261.   END WriteTextAttrInit;
  262.  
  263.  
  264.  
  265.   PROCEDURE WriteScreenColorInit;
  266.  
  267.   VAR    i            :CARDINAL;
  268.  
  269.   BEGIN
  270.   IF Custom IN Gui.flags0 THEN
  271.     WriteLn (mfile);
  272.     WriteString (mfile, "PROCEDURE Init");
  273.     WriteString (mfile, args.BaseName);
  274.     WriteString (mfile, "ScreenColors;");
  275.     WriteLn (mfile);
  276.     WriteLn (mfile);
  277.  
  278.     WriteString (mfile, "BEGIN");
  279.     WriteLn (mfile);
  280.  
  281.  
  282.     IF Gui.colors[0].colorIndex # -1 THEN
  283.       i := 0;
  284.       WHILE (i < maxColorSpec) AND
  285.             (Gui.colors[i].colorIndex # -1) DO
  286.         WriteString (mfile, "ScreenColors[");
  287.         WriteCard   (mfile, i, 2);
  288.         WriteString (mfile, "].colorIndex := ");
  289.         WriteInt    (mfile, Gui.colors[i].colorIndex, 2);
  290.         WriteString (mfile, ";  ");
  291.  
  292.         WriteString (mfile, "ScreenColors[");
  293.         WriteCard   (mfile, i, 2);
  294.         WriteString (mfile, "].red := ");
  295.         WriteHex    (mfile, Gui.colors[i].red, 4);
  296.         WriteString (mfile, "H;  ");
  297.  
  298.         WriteString (mfile, "ScreenColors[");
  299.         WriteCard   (mfile, i, 2);
  300.         WriteString (mfile, "].green := ");
  301.         WriteHex    (mfile, Gui.colors[i].green, 4);
  302.         WriteString (mfile, "H;  ");
  303.  
  304.         WriteString (mfile, "ScreenColors[");
  305.         WriteCard   (mfile, i, 2);
  306.         WriteString (mfile, "].blue := ");
  307.         WriteHex    (mfile, Gui.colors[i].blue, 4);
  308.         WriteString (mfile, "H;");
  309.         WriteLn (mfile);
  310.  
  311.         INC (i)
  312.         END;
  313.  
  314.       WriteString (mfile, "ScreenColors[");
  315.       WriteCard   (mfile, i, 2);
  316.       WriteString (mfile, "].colorIndex := MAX (CARDINAL);");
  317.  
  318.       WriteString (mfile, "ScreenColors[");
  319.       WriteCard   (mfile, i, 2);
  320.       WriteString (mfile, "].red := 0070H;  ");
  321.  
  322.       WriteString (mfile, "ScreenColors[");
  323.       WriteCard   (mfile, i, 2);
  324.       WriteString (mfile, "].green := 0700H;  ");
  325.  
  326.       WriteString (mfile, "ScreenColors[");
  327.       WriteCard   (mfile, i, 2);
  328.       WriteString (mfile, "].blue := 0007H;");
  329.       WriteLn (mfile);
  330.       WriteLn (mfile)
  331.       END;
  332.  
  333.  
  334.     i := 0;
  335.     WHILE (i < maxDriPens) AND
  336.           (Gui.driPens[i] # MAX (CARDINAL)) DO
  337.       WriteString (mfile, "DriPens[");
  338.       WriteCard   (mfile, i, 2);
  339.       WriteString (mfile, "] :=");
  340.       WriteInt    (mfile, Gui.driPens[i], 2);
  341.       Write       (mfile, ";");
  342.       WriteLn (mfile);
  343.  
  344.       INC (i)
  345.       END;
  346.  
  347.     WriteString (mfile, "DriPens[");
  348.     WriteCard   (mfile, i, 2);
  349.     WriteString (mfile, "] := MAX (CARDINAL);");
  350.     WriteLn (mfile);
  351.  
  352.  
  353.     WriteString (mfile, "END Init");
  354.     WriteString (mfile, args.BaseName);
  355.     WriteString (mfile, "ScreenColors;");
  356.     WriteLn (mfile);
  357.     WriteLn (mfile)
  358.     END
  359.   END WriteScreenColorInit;
  360.  
  361.  
  362.  
  363.   PROCEDURE WriteScreenCreate    (    attrName        :ARRAY OF CHAR);
  364.  
  365.  
  366.     PROCEDURE WriteIDFlags    (    flags        :LONGSET);
  367.  
  368.     CONST    palMonitorSet    =CAST (LONGSET, palMonitorID);
  369.         ntscMonitorSet    =CAST (LONGSET, ntscMonitorID);
  370.  
  371.         superlaceKeySet    =CAST (LONGSET, superlaceKey);
  372.         hireslaceKeySet    =CAST (LONGSET, hireslaceKey);
  373.         loreslaceKeySet    =CAST (LONGSET, loreslaceKey);
  374.         superKeySet    =CAST (LONGSET, superKey);
  375.         hiresKeySet    =CAST (LONGSET, hiresKey);
  376.  
  377.     BEGIN
  378.     IF    (palMonitorSet * flags) # LONGSET {} THEN
  379.       WriteString (mfile, "palMonitorID+")
  380.     ELSIF (ntscMonitorSet * flags) # LONGSET {} THEN
  381.       WriteString (mfile, "ntscMonitorID+")
  382.       END;
  383.  
  384.     IF    (superlaceKeySet * flags) # LONGSET {} THEN
  385.       WriteString (mfile, "superlaceKey+")
  386.     ELSIF (hireslaceKeySet * flags) # LONGSET {} THEN
  387.       WriteString (mfile, "hireslaceKey+")
  388.     ELSIF (loreslaceKeySet * flags) # LONGSET {} THEN
  389.       WriteString (mfile, "loreslaceKey+")
  390.     ELSIF (superKeySet     * flags) # LONGSET {} THEN
  391.       WriteString (mfile, "superKey+")
  392.     ELSIF (hiresKeySet     * flags) # LONGSET {} THEN
  393.       WriteString (mfile, "hiresKey+")
  394.       END;
  395.  
  396.     SeekBack (mfile, 1)
  397.     END WriteIDFlags;
  398.  
  399.  
  400.   (* WriteScreenCreate *)
  401.   BEGIN
  402.   WriteLn (dfile);
  403.   WriteString (dfile, "PROCEDURE Create");
  404.   WriteString (dfile, args.BaseName);
  405.   WriteString (dfile, "Screen");
  406.   IF Public IN Gui.flags0 THEN
  407.     WriteFill   (dfile, args.BaseName, 20);
  408.     WriteString (dfile, "(    pubScreenName");
  409.     WriteFill   (dfile, "", 17);
  410.     WriteString (dfile, ":ARRAY OF CHAR")
  411.   ELSE
  412.     WriteString (dfile, " (")
  413.     END;
  414.   WriteString (dfile, ") :CARDINAL;");
  415.   WriteLn (dfile);
  416.   WriteLn (dfile);
  417.  
  418.  
  419.   WriteLn (mfile);
  420.   WriteString (mfile, "PROCEDURE Create");
  421.   WriteString (mfile, args.BaseName);
  422.   WriteString (mfile, "Screen");
  423.   IF Public IN Gui.flags0 THEN
  424.     WriteFill   (mfile, args.BaseName, 20);
  425.     WriteString (mfile, "(    pubScreenName");
  426.     WriteFill   (mfile, "", 17);
  427.     WriteString (mfile, ":ARRAY OF CHAR")
  428.   ELSE
  429.     WriteString (mfile, " (")
  430.     END;
  431.   WriteString (mfile, ") :CARDINAL;");
  432.   WriteLn (mfile);
  433.   WriteLn (mfile);
  434.  
  435.  
  436.  
  437.   IF (Custom IN Gui.flags0) OR GetFilePresent THEN
  438.     WriteString (mfile, "VAR")
  439.     END;
  440.  
  441.   IF Custom IN Gui.flags0 THEN
  442.     WriteString (mfile, "\t");
  443.     WriteString (mfile, "screenTagPtr");
  444.     WriteFill   (mfile, "", 12);
  445.     WriteString (mfile, ":TagItemPtr;");
  446.     WriteLn (mfile);
  447.  
  448.     WriteString (mfile, "\t");
  449.     WriteString (mfile, "screenTags");
  450.     WriteFill   (mfile, "", 10);
  451.     WriteString (mfile, ":ARRAY SaTags OF TagItem;");
  452.     WriteLn (mfile);
  453.     WriteLn (mfile)
  454.     END;
  455.  
  456.   IF GetFilePresent THEN
  457.     WriteString (mfile, "\t");
  458.     WriteString (mfile, "objectTagPtr");
  459.     WriteFill   (mfile, "", 12);
  460.     WriteString (mfile, ":TagItemPtr;");
  461.     WriteLn (mfile);
  462.  
  463.     WriteString (mfile, "\t");
  464.     WriteString (mfile, "objectTags");
  465.     WriteFill   (mfile, "", 10);
  466.     WriteString (mfile, ":ARRAY [0..1] OF TagItem;");
  467.     WriteLn (mfile);
  468.     WriteLn (mfile)
  469.     END;
  470.  
  471.  
  472.  
  473.   WriteString (mfile, "BEGIN");
  474.   WriteLn (mfile);
  475.  
  476.   WriteString (mfile, "Assert (");
  477.   WriteString (mfile, "Screen = NIL, ADR ('");
  478.   WriteString (mfile, args.BaseName);
  479.   WriteString (mfile, "Screen is already open!'));");
  480.   WriteLn (mfile);
  481.   WriteLn (mfile);
  482.  
  483.  
  484.   IF CheckFont () THEN
  485.     WriteString (mfile, "Font := OpenDiskFont (ADR (");
  486.     WriteString (mfile, attrName);
  487.     WriteString (mfile, "));");
  488.     WriteLn (mfile);
  489.  
  490.     WriteString (mfile, "IF Font = NIL THEN");
  491.     WriteLn (mfile);
  492.  
  493.     WriteString (mfile, "  RETURN 3");
  494.     WriteLn (mfile);
  495.  
  496.     WriteString (mfile, "  END;");
  497.     WriteLn (mfile);
  498.     WriteLn (mfile)
  499.     END;
  500.  
  501.  
  502.   IF Workbench IN Gui.flags0 THEN
  503.     WriteString (mfile, "Screen := LockPubScreen (ADR ('Workbench'));");
  504.     WriteLn (mfile)
  505.  
  506.   ELSIF Public IN Gui.flags0 THEN
  507.     WriteString (mfile, "IF pubScreenName[0] = 0C THEN");
  508.     WriteLn (mfile);
  509.  
  510.     WriteString (mfile, "  Screen := LockPubScreen (NIL)");
  511.     WriteLn (mfile);
  512.  
  513.     WriteString (mfile, "ELSE");
  514.     WriteLn (mfile);
  515.  
  516.     WriteString (mfile, "  Screen := LockPubScreen (ADR (pubScreenName))");
  517.     WriteLn (mfile);
  518.  
  519.     WriteString (mfile, "  END;");
  520.     WriteLn (mfile)
  521.  
  522.   ELSIF Custom IN Gui.flags0 THEN
  523.     WriteString (mfile, "screenTagPtr := TAG (screenTags,");
  524.     WriteLn (mfile);
  525.  
  526.     WriteString (mfile, "\t\t");
  527.     WriteString (mfile, "saLeft,");
  528.     WriteFill   (mfile, "", 7);
  529.     WriteCard   (mfile, Gui.left, 3);
  530.     Write       (mfile, ",");
  531.     WriteLn (mfile);
  532.  
  533.     WriteString (mfile, "\t\t");
  534.     WriteString (mfile, "saTop,");
  535.     WriteFill   (mfile, "", 6);
  536.     WriteCard   (mfile, Gui.top, 3);
  537.     Write       (mfile, ",");
  538.     WriteLn (mfile);
  539.  
  540.     WriteString (mfile, "\t\t");
  541.     WriteString (mfile, "saHeight,");
  542.     WriteFill   (mfile, "", 9);
  543.     WriteCard   (mfile, Gui.height, 3);
  544.     Write       (mfile, ",");
  545.     WriteLn (mfile);
  546.  
  547.     WriteString (mfile, "\t\t");
  548.     WriteString (mfile, "saWidth,");
  549.     WriteFill   (mfile, "", 8);
  550.     WriteCard   (mfile, Gui.width, 3);
  551.     Write       (mfile, ",");
  552.     WriteLn (mfile);
  553.  
  554.     WriteString (mfile, "\t\t");
  555.     WriteString (mfile, "saDepth,");
  556.     WriteFill   (mfile, "", 8);
  557.     WriteCard   (mfile, Gui.depth, 3);
  558.     Write       (mfile, ",");
  559.     WriteLn (mfile);
  560.  
  561.     WriteString (mfile, "\t\t");
  562.     WriteString (mfile, "saType,");
  563.     WriteFill   (mfile, "", 7);
  564.     WriteString (mfile, "customScreen,");
  565.     WriteLn (mfile);
  566.  
  567.     IF Gui.colors[0].colorIndex # -1 THEN
  568.       WriteString (mfile, "\t\t");
  569.       WriteString (mfile, "saColors,");
  570.       WriteFill   (mfile, "", 8);
  571.       WriteString (mfile, "ADR (ScreenColors),");
  572.       WriteLn (mfile)
  573.       END;
  574.  
  575.     IF NOT (FontAdapt IN MainConfig.configFlags0) THEN
  576.       WriteString (mfile, "\t\t");
  577.       WriteString (mfile, "saFont,");
  578.       WriteFill   (mfile, "", 7);
  579.       WriteString (mfile, "ADR (");
  580.       WriteString (mfile, attrName);
  581.       WriteString (mfile, "),");
  582.       WriteLn (mfile)
  583.       END;
  584.  
  585.     WriteString (mfile, "\t\t");
  586.     WriteString (mfile, "saDisplayID,");
  587.     WriteFill   (mfile, "", 10);
  588.     WriteIDFlags (Gui.displayID);
  589.     Write       (mfile, ",");
  590.     WriteLn (mfile);
  591.  
  592.     IF AutoScroll IN Gui.flags0 THEN
  593.       WriteString (mfile, "\t\t");
  594.       WriteString (mfile, "saAutoScroll,");
  595.       WriteFill   (mfile, "", 13);
  596.       WriteString (mfile, "TRUE,");
  597.       WriteLn (mfile);
  598.  
  599.       (*
  600.       WriteString (mfile, "\t\t");
  601.       WriteString (mfile, "saOverScan,");
  602.       WriteFill   (mfile, "" 13);
  603.       WriteString (mfile, "oScanText,");
  604.       WriteLn (mfile);
  605.       *)
  606.       END;
  607.  
  608.     WriteString (mfile, "\t\t");
  609.     WriteString (mfile, "saPens,");
  610.     WriteFill   (mfile, "", 7);
  611.     WriteString (mfile, "ADR (DriPens),");
  612.     WriteLn (mfile);
  613.  
  614.     IF 0 < Length (Gui.screenTitle) THEN
  615.       WriteString (mfile, "\t\t");
  616.       WriteString (mfile, "saPens,");
  617.       WriteFill   (mfile, "", 7);
  618.       WriteString (mfile, "ADR ('");
  619.       WriteText   (mfile, Gui.screenTitle);
  620.       WriteString (mfile, "'),");
  621.       WriteLn (mfile)
  622.       END;
  623.  
  624.     WriteString (mfile, "\t\t");
  625.     WriteString (mfile, "tagEnd);");
  626.     WriteLn (mfile);
  627.  
  628.  
  629.     WriteString (mfile, "Screen := OpenScreenTagList(NIL, screenTagPtr);");
  630.     WriteLn (mfile)
  631.     END;
  632.  
  633.   WriteString (mfile, "IF Screen = NIL THEN");
  634.   WriteLn (mfile);
  635.  
  636.   WriteString (mfile, "  RETURN 1");
  637.   WriteLn (mfile);
  638.  
  639.   WriteString (mfile, "  END;");
  640.   WriteLn (mfile);
  641.   WriteLn (mfile);
  642.  
  643.  
  644.   IF FontAdapt IN MainConfig.configFlags0 THEN
  645.     WriteString (mfile, "ComputeFont (0, 0);");
  646.     WriteLn (mfile)
  647.     END;
  648.  
  649.  
  650.   WriteString (mfile, "VisualInfo := GetVisualInfoA (Screen, NIL);");
  651.   WriteLn (mfile);
  652.  
  653.   WriteString (mfile, "IF VisualInfo = NIL THEN");
  654.   WriteLn (mfile);
  655.  
  656.   WriteString (mfile, "  RETURN 2");
  657.   WriteLn (mfile);
  658.  
  659.   WriteString (mfile, "  END;");
  660.   WriteLn (mfile);
  661.   WriteLn (mfile);
  662.  
  663.  
  664.   IF GetFilePresent THEN
  665.     WriteString (mfile, "objectTagPtr := TAG (objectTags,");
  666.     WriteLn (mfile);
  667.  
  668.     WriteString (mfile, "\t\t");
  669.     WriteString (mfile, "gtVisualInfo,");
  670.     WriteFill   (mfile, "", 13);
  671.     WriteString (mfile, "VisualInfo,");
  672.     WriteLn (mfile);
  673.  
  674.     WriteString (mfile, "\t\t");
  675.     WriteString (mfile, "tagEnd);");
  676.     WriteLn (mfile);
  677.  
  678.  
  679.     WriteString (mfile, "GetImage := NewObjectA (GetFileClass, NIL, objectTagPtr);");
  680.     WriteLn (mfile);
  681.  
  682.     WriteString (mfile, "IF GetImage = NIL THEN");
  683.     WriteLn (mfile);
  684.  
  685.     WriteString (mfile, "  RETURN 4");
  686.     WriteLn (mfile);
  687.  
  688.     WriteString (mfile, "  END;");
  689.     WriteLn (mfile);
  690.     WriteLn (mfile)
  691.     END;
  692.  
  693.  
  694.   WriteString (mfile, "RETURN 0");
  695.   WriteLn (mfile);
  696.  
  697.  
  698.   WriteString (mfile, "END Create");
  699.   WriteString (mfile, args.BaseName);
  700.   WriteString (mfile, "Screen;");
  701.   WriteLn (mfile);
  702.   WriteLn (mfile)
  703.   END WriteScreenCreate;
  704.  
  705.  
  706.  
  707.   PROCEDURE WriteScreenFree;
  708.  
  709.   BEGIN
  710.   WriteLn (dfile);
  711.   WriteString (dfile, "PROCEDURE Free");
  712.   WriteString (dfile, args.BaseName);
  713.   WriteString (dfile, "Screen;");
  714.   WriteLn (dfile);
  715.   WriteLn (dfile);
  716.  
  717.  
  718.   WriteLn (mfile);
  719.   WriteString (mfile, "PROCEDURE Free");
  720.   WriteString (mfile, args.BaseName);
  721.   WriteString (mfile, "Screen;");
  722.   WriteLn (mfile);
  723.   WriteLn (mfile);
  724.  
  725.  
  726.   WriteString (mfile, "BEGIN");
  727.   WriteLn (mfile);
  728.  
  729.   IF GetFilePresent THEN
  730.     WriteString (mfile, "IF GetImage # NIL THEN");
  731.     WriteLn (mfile);
  732.  
  733.     WriteString (mfile, "  DisposeObject (GetImage);");
  734.     WriteLn (mfile);
  735.  
  736.     WriteString (mfile, "  GetImage := NIL;");
  737.     WriteLn (mfile);
  738.  
  739.     WriteString (mfile, "  END;");
  740.     WriteLn (mfile);
  741.     WriteLn (mfile)
  742.     END;
  743.  
  744.  
  745.   WriteString (mfile, "IF VisualInfo # NIL THEN");
  746.   WriteLn (mfile);
  747.  
  748.   WriteString (mfile, "  FreeVisualInfo (VisualInfo);");
  749.   WriteLn (mfile);
  750.  
  751.   WriteString (mfile, "  VisualInfo := NIL");
  752.   WriteLn (mfile);
  753.  
  754.   WriteString (mfile, "  END;");
  755.   WriteLn (mfile);
  756.   WriteLn (mfile);
  757.  
  758.  
  759.   WriteString (mfile, "IF Screen # NIL THEN");
  760.   WriteLn (mfile);
  761.  
  762.   IF Custom IN Gui.flags0 THEN
  763.     WriteString (mfile, "  CloseScreen (Screen);")
  764.   ELSE
  765.     WriteString (mfile, "  UnlockPubScreen (NIL, Screen);")
  766.     END;
  767.   WriteLn (mfile);
  768.  
  769.   WriteString (mfile, "  Screen := NIL");
  770.   WriteLn (mfile);
  771.  
  772.   WriteString (mfile, "  END;");
  773.   WriteLn (mfile);
  774.  
  775.  
  776.  
  777.   IF CheckFont () THEN
  778.     WriteLn (mfile);
  779.     WriteString (mfile, "IF Font # NIL THEN");
  780.     WriteLn (mfile);
  781.  
  782.     WriteString (mfile, "  CloseFont (Font);");
  783.     WriteLn (mfile);
  784.  
  785.     WriteString (mfile, "  Font := NIL;");
  786.     WriteLn (mfile);
  787.  
  788.     WriteString (mfile, "  END;");
  789.     WriteLn (mfile)
  790.     END;
  791.  
  792.   WriteString (mfile, "END Free");
  793.   WriteString (mfile, args.BaseName);
  794.   WriteString (mfile, "Screen;");
  795.   WriteLn (mfile);
  796.   WriteLn (mfile)
  797.   END WriteScreenFree;
  798.  
  799.  
  800.  
  801. (* WriteScreenProcs *)
  802. BEGIN
  803. GetAttrName (attrName);
  804.  
  805. WriteTextAttrInit (attrName);
  806. WriteScreenColorInit;
  807.  
  808. WriteScreenCreate (attrName);
  809. WriteScreenFree
  810. END WriteScreenProcs;
  811.  
  812.  
  813.  
  814. PROCEDURE WriteScreenInit;
  815.  
  816. BEGIN
  817. IF NOT (FontAdapt IN MainConfig.configFlags0) THEN
  818.   WriteString (mfile, "Init");
  819.   WriteString (mfile, args.BaseName);
  820.   WriteString (mfile, "TextAttr;");
  821.   WriteLn (mfile)
  822.   END;
  823.  
  824. IF Custom IN Gui.flags0 THEN
  825.   WriteString (mfile, "Init");
  826.   WriteString (mfile, args.BaseName);
  827.   WriteString (mfile, "ScreenColors;");
  828.   WriteLn (mfile)
  829.   END
  830. END WriteScreenInit;
  831.  
  832.  
  833.  
  834. PROCEDURE WriteScreenExit;
  835.  
  836. BEGIN
  837. WriteString (mfile, "Free");
  838. WriteString (mfile, args.BaseName);
  839. WriteString (mfile, "Screen;");
  840. WriteLn (mfile)
  841. END WriteScreenExit;
  842.  
  843.  
  844.  
  845.  
  846. END GenerateScreen.
  847.